home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln0385.arc / MODULA1.LTG < prev    next >
Text File  |  1986-02-27  |  7KB  |  245 lines
  1.  
  2.  
  3. Module2Listing 1.  The implementation module of MatMan.
  4.  
  5.  
  6. IMPLEMENTATION MODULE MatMan;
  7.  
  8. (*-------------------------------------------------------------------*)
  9. (*              Modula-2 Matrix Management Module                    *)
  10. (*                                                                   *)
  11. (*  Copyright (c) 1984 by  Namir Clement Shammas                     *)
  12. (*  Version 1.0,  August 31, 1984                                    *)
  13. (*-------------------------------------------------------------------*)
  14.  
  15. PROCEDURE Loc( Row, Col : CARDINAL): CARDINAL;
  16. (* Procedure to locate the (i,j) matrix element, with a default *)
  17. (* HIROW number of rows.                    *)
  18.  
  19. BEGIN
  20.     RETURN ( (Col - 1) * HIROW + Row)
  21. END Loc;
  22.  
  23. (*-------------------------------------------------------------------*)
  24.  
  25. PROCEDURE Loc0( Row, Col : CARDINAL): CARDINAL;
  26. (* Procedure to locate the (i,j) matrix element, with a default *)
  27. (* HIROW number of rows. Used in subroutines with open arrays.  *)
  28.  
  29. BEGIN
  30.     RETURN ( (Col - 1) * HIROW + Row - 1)
  31. END Loc0;
  32.  
  33. (*-------------------------------------------------------------------*)
  34.  
  35. PROCEDURE LOC( Row, Col, HiRow : CARDINAL): CARDINAL;
  36. (* Procedure to locate the (i,j) matrix element, with an assigned *)
  37. (* HiRow number of rows.                      *)
  38.  
  39. BEGIN
  40.     RETURN ( (Col - 1) * HiRow + Row)
  41. END LOC;
  42.  
  43. (*-------------------------------------------------------------------*)
  44.  
  45. PROCEDURE LOC0( Row, Col, HiRow : CARDINAL): CARDINAL;
  46. (* Procedure to locate the (i,j) matrix element, with an assigned *)
  47. (* HiRow number of rows. Used in subroutines with open arrays.    *)
  48.  
  49. BEGIN
  50.     RETURN ( (Col - 1) * HiRow + Row - 1)
  51. END LOC0;
  52.  
  53. (*-------------------------------------------------------------------*)
  54.  
  55. PROCEDURE Swap( VAR A, B : REAL);è(* Procedure to swap two REALs *)
  56.  
  57. VAR Tempo : REAL;
  58.  
  59. BEGIN
  60.     Tempo := A;
  61.     A := B;
  62.     B := Tempo;
  63. END Swap;
  64.  
  65. (*-------------------------------------------------------------------*)
  66.  
  67. PROCEDURE SwapColumn(VAR X : ARRAY OF REAL; Col1, Col2, HiRow : CARDINAL);
  68. (* Procedure to swap two columns, Col1 and Col2 *)
  69.  
  70. VAR i, L1, L2 :  CARDINAL;
  71.  
  72. BEGIN
  73.     L1 := LOC0(1,Col1,HiRow);
  74.     L2 := LOC0(1,Col2,HiRow);
  75.  
  76.     FOR i := 0 TO HiRow-1 DO
  77.         Swap(X[L1+i],X[L2+i])
  78.     END;
  79. END SwapColumn;    
  80.  
  81. (*-------------------------------------------------------------------*)
  82.  
  83. PROCEDURE SwapRow(VAR X : ARRAY OF REAL; Row1, Row2, HiRow, HiCol : CARDINAL);
  84. (* Procedure to swap two rows, Row1 and Row2 *)
  85.  
  86. VAR i, R1, R2 :  CARDINAL;
  87.  
  88. BEGIN
  89.     R1 := LOC0(Row1,1,HiRow);
  90.     R2 := LOC0(Row2,1,HiRow);
  91.  
  92.     FOR i := 1 TO HiCol DO
  93.         Swap(X[R1],X[R2]);
  94.         INC(R1,HiRow);
  95.         INC(R2,HiRow)
  96.     END;
  97. END SwapRow;
  98.  
  99. (*-------------------------------------------------------------------*)
  100.  
  101. PROCEDURE Transpose(VAR X, Y : ARRAY OF REAL; HiRow, HiCol : CARDINAL);
  102. (* Procedure to transpose matrix  X into matrix Y *)
  103.  
  104. VAR i, j : CARDINAL;
  105.  
  106. BEGIN
  107.     FOR i := 1 TO HiRow DO
  108.         FOR j := 1 TO HiCol DO
  109.                     Y[LOC0(j,i,HiCol)] := X[LOC0(i,j,HiRow)]è        END; (* FOR *)
  110.     END; (* FOR *)
  111.  
  112. END Transpose;
  113.  
  114. (*-------------------------------------------------------------------*)
  115.  
  116. PROCEDURE InsertColumn(VAR X, Y : ARRAY OF REAL; NewCol : CARDINAL;
  117.                        VAR HiRow, HiCol : CARDINAL);
  118. (* Procedure to insert a new array Y at column NewCol in matrix X *)
  119.  
  120. VAR i, L, MatSize : CARDINAL;
  121.  
  122. BEGIN
  123.     IF NewCol <= HiCol THEN 
  124.         L := LOC0(1,NewCol,HiRow);
  125.         MatSize := HiRow * HiCol; (* Initial matrix size *)
  126.         (* Move element upward in matrix X *)
  127.         FOR i := MatSize - 1 TO L BY -1 DO
  128.             X[i + HiRow] := X[i]
  129.         END;
  130.         (* Insert column Y *)
  131.         FOR i := 0 TO HiRow - 1 DO
  132.             X[L+i] := Y[i]
  133.         END;
  134.         INC(HiCol);    
  135.     END; (* IF *)
  136.  
  137. END InsertColumn;
  138.  
  139. (*-------------------------------------------------------------------*)
  140.  
  141. PROCEDURE InsertRow(VAR X, Y : ARRAY OF REAL; NewRow : CARDINAL; 
  142.                     VAR HiRow, HiCol : CARDINAL);
  143. (* Procedure to insert a new array Y at row NewRow in matrix X *)
  144.  
  145. VAR i, j, L1, L2 : CARDINAL;
  146.  
  147. BEGIN
  148.     IF NewRow <= HiRow THEN 
  149.         FOR i := HiCol TO 1 BY -1 DO
  150.             L1 := LOC0(HiRow,i,HiRow);
  151.             L2 := LOC0((HiRow+1),i,(HiRow+1));
  152.             FOR j := 0 TO HiRow - NewRow  DO
  153.                 X[L2-j] := X[L1-j]
  154.             END; (* FOR *)
  155.             X[L2 - HiRow + NewRow - 1] := Y[i-1];
  156.             IF NewRow > 1 THEN 
  157.                 L1 := LOC0((NewRow-1),i,HiRow);
  158.                 L2 := LOC0((NewRow-1),i,(HiRow+1));
  159.                 FOR j := 0 TO NewRow -2  DO
  160.                     X[L2-j] := X[L1-j]
  161.                 END; (* FOR *)
  162.             END; (* IF *)
  163.         END; (* FOR *)è        INC(HiRow)
  164.     END; (* IF *)
  165.  
  166. END InsertRow;
  167.  
  168. (*-------------------------------------------------------------------*)
  169.  
  170. PROCEDURE ResizeMat(VAR X : ARRAY OF REAL; 
  171.                     OldHiRow, NewHiRow, HiCol: CARDINAL);
  172. (* Procedure to resize matrix X by reassigning the number of rows *)
  173.  
  174. VAR i, j, L1, L2, Row : CARDINAL;
  175.  
  176. BEGIN
  177.     IF NewHiRow < OldHiRow THEN  Row := NewHiRow
  178.                            ELSE  Row := OldHiRow END;
  179.     FOR i := HiCol TO 2 BY -1 DO
  180.         L1 := LOC0(Row,i,OldHiRow);
  181.         L2 := LOC0(Row,i,NewHiRow);
  182.         FOR j := 0 TO Row -1 DO
  183.             X[L2-j] := X[L1-j]
  184.         END; (* FOR *)
  185.     END; (* FOR *)
  186.  
  187. END ResizeMat;
  188.  
  189. (*-------------------------------------------------------------------*)
  190.  
  191. PROCEDURE DeleteColumn(VAR X : ARRAY OF REAL; Col, HiRow : CARDINAL;
  192.                        VAR HiCol : CARDINAL);
  193. (* Procedure to remove column Col from matrix X *)
  194.  
  195.  
  196. VAR i, L, MatSize : CARDINAL;
  197.  
  198. BEGIN
  199.     IF Col <= HiCol THEN 
  200.         IF Col < HiCol THEN
  201.             L := LOC0(1,Col,HiRow);
  202.             MatSize := HiRow * HiCol;
  203.             FOR i := L + HiRow TO MatSize - 1 DO
  204.                 X[i-HiRow] := X[i]
  205.             END; (* FOR *)
  206.         END; (* IF *)
  207.         DEC(HiCol)
  208.      END; (* IF *)
  209.  
  210. END DeleteColumn;
  211.  
  212. (*-------------------------------------------------------------------*)
  213.  
  214. PROCEDURE DeleteRow(VAR X : ARRAY OF REAL; Row, HiCol : CARDINAL;
  215.                        VAR HiRow : CARDINAL);
  216. (* Procedure to remove row 'Row' from matrix X *)
  217. è
  218. VAR i, j, L1, L2 : CARDINAL;
  219.  
  220. BEGIN
  221.     IF Row <= HiRow THEN 
  222.         IF Row = HiRow 
  223.             THEN ResizeMat(X,HiRow,(HiRow-1),HiCol)
  224.             ELSE
  225.                  FOR i := 1 TO HiCol DO
  226.                      L1 := LOC0(1,i,HiRow);
  227.                      L2 := LOC0(1,i,(HiRow-1));
  228.                      IF Row > 1 THEN 
  229.                         FOR j := 0 TO Row-2 DO
  230.                             X[L2+j] := X[L1+j]
  231.                         END; (* FOR *)
  232.                      END; (* IF *)
  233.                      FOR j := Row-1 TO HiRow-1 DO
  234.                          X[L2+j] := X[L2+j+1]
  235.                      END; (* FOR *)
  236.                  END; (* FOR *)
  237.         END; (* IF *)                        
  238.         DEC(HiRow);
  239.     END; (* IF *)
  240.  
  241. END DeleteRow;
  242.  
  243. END MatMan.
  244.  
  245.